home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / pgmmenu.arc / CRC1239.CLP < prev    next >
Text File  |  1991-12-04  |  15KB  |  300 lines
  1.  CRC1239:    PGM        PARM(&SRCLIB &OBJLIB &MSGLIB &OBJOWN)
  2.  
  3.              /*    Program - CRC1239  */
  4.              /*    CPP for command PGMSETUP */
  5.  
  6.              /*    Set up message file & all other objects +
  7.                    required by CL-Programmer Menu. */
  8.  
  9.  
  10.              DCL        &SRCLIB *CHAR 10  /* Source library */
  11.              DCL        &OBJLIB *CHAR 10  /* Object's library */
  12.              DCL        &MSGLIB *CHAR 10  /* Message file library */
  13.              DCL        &OBJOWN *CHAR 10  /* Owner of object. */
  14.              DCL        &LIBL   *CHAR 275 /* Library list */
  15.              DCL        &CMD    *CHAR 512 /* RPLLIBL CMD */
  16.  
  17.              DCL        &MSGID  *CHAR 7
  18.              DCL        &MSGDTA *CHAR 132
  19.              DCL        &CNT    *DEC  3
  20.              MONMSG     MSGID(CPF0000)
  21.  
  22.              RTVJOBA    USRLIBL(&LIBL) /* Save current library list */
  23.              CHGJOB     LOGCLPGM(*YES) /* Log all CL commands */
  24.  
  25.  CHKLIB:     IF         (&MSGLIB *EQ *USRLIBL) +
  26.              CHGVAR     VAR(&MSGLIB) VALUE(%SST(&LIBL 01 10))
  27.              IF         (&SRCLIB *EQ *USRLIBL) +
  28.              CHGVAR     VAR(&SRCLIB) VALUE(%SST(&LIBL 01 10))
  29.              IF         (&OBJLIB *EQ *USRLIBL) +
  30.              CHGVAR     VAR(&OBJLIB) VALUE(%SST(&LIBL 01 10))
  31.  
  32.  CHKLIBAUT:  CHKOBJ     OBJ(&MSGLIB.QSYS) OBJTYPE(*LIB)
  33.              MONMSG     MSGID(CPF9800) EXEC(GOTO RCVMSG)
  34.              CHKOBJ     OBJ(&SRCLIB.QSYS) OBJTYPE(*LIB)
  35.              MONMSG     MSGID(CPF9800) EXEC(GOTO RCVMSG)
  36.              CHKOBJ     OBJ(&OBJLIB.QSYS) OBJTYPE(*LIB)
  37.              MONMSG     MSGID(CPF9800) EXEC(GOTO RCVMSG)
  38.              IF         (&OBJOWN *NE *CURRENT) DO
  39.              CHKOBJ     OBJ(&OBJOWN) OBJTYPE(*USRPRF)
  40.              MONMSG     MSGID(CPF9800) EXEC(GOTO RCVMSG)
  41.              ENDDO
  42.  
  43.  FIXLIBL:    IF         ((&MSGLIB *EQ QGPL) *OR (&SRCLIB *EQ QGPL) +
  44.                           *OR (&OBJLIB *EQ QGPL)) +
  45.              RPLLIBL    LIBL(QTEMP QRPG QIDU)
  46.              ELSE       CMD(RPLLIBL LIBL(QGPL QTEMP QRPG QIDU))
  47.              ADDLIBLE   (&MSGLIB)          /* Set up job's library */
  48.              MONMSG     MSGID(CPF2100)     /* list to contain the  */
  49.              ADDLIBLE   (&SRCLIB)          /* three specified      */
  50.              MONMSG     MSGID(CPF2100)     /* library names.       */
  51.              ADDLIBLE   (&OBJLIB)
  52.              MONMSG     MSGID(CPF2100)
  53.  
  54.  CRTMSGF:    /*         Create message file and messages. */
  55.              CRTMSGF    MSGF(CRCMSGF.&MSGLIB) TEXT('CRC - +
  56.                           Message file for COZZI UTILITIES')
  57.  
  58.              ADDMSGD    MSGID(PGM0001) MSGF(CRCMSGF.&MSGLIB) +
  59.                           MSG('CRTCMD CMD(&1.&2) PGM(&3) +
  60.                           SRCFILE(&4.&5) PUBAUT(&6) TEXT(&7)') +
  61.                           FMT((*CHAR 10) (*CHAR 10) (*CHAR 21) (*CHAR +
  62.                           10) (*CHAR 10) (*CHAR 7) (*CHAR 50)) /* +
  63.                           Create CRTCMD command */
  64.  
  65.              ADDMSGD    MSGID(PGM0002) MSGF(CRCMSGF.&MSGLIB) +
  66.                           MSG('CRTCLPGM PGM(&1.&2) SRCFILE(&3.&4) +
  67.                           USRPRF(&5) LOG(&6) ALWRTVSRC(&7) PUBAUT(&8) +
  68.                           TEXT(&9)') FMT((*CHAR 10) (*CHAR 10) (*CHAR +
  69.                           10) (*CHAR 10) (*CHAR 6) (*CHAR 4) (*CHAR +
  70.                           4) (*CHAR 7) (*CHAR 50)) /* Create CRTCLP +
  71.                           command */
  72.  
  73.              ADDMSGD    MSGID(PGM0003) MSGF(CRCMSGF.&MSGLIB) +
  74.                           MSG('CRTCMNF FILE(&1.&2) SRCFILE(&3.&4) +
  75.                           PUBAUT(&5) TEXT(&6)') FMT((*CHAR 10) (*CHAR +
  76.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*CHAR +
  77.                           50)) /* Create CRTCMNF command */
  78.  
  79.              ADDMSGD    MSGID(PGM0004) MSGF(CRCMSGF.&MSGLIB) +
  80.                           MSG('CRTDFUAPP APP(&1.&2) SRCFILE(&3.&4) +
  81.                           USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
  82.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
  83.                           6) (*CHAR 7) (*CHAR 50)) /* Create +
  84.                           CRTDFUAPP command */
  85.  
  86.              ADDMSGD    MSGID(PGM0005) MSGF(CRCMSGF.&MSGLIB) +
  87.                           MSG('CRTQRYAPP APP(&1.&2) SRCFILE(&3.&4) +
  88.                           USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
  89.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
  90.                           6) (*CHAR 7) (*CHAR 50)) /* Create +
  91.                           CRTQRYAPP command */
  92.  
  93.              ADDMSGD    MSGID(PGM0006) MSGF(CRCMSGF.&MSGLIB) +
  94.                           MSG('CRTDSPF FILE(&1.&2) SRCFILE(&3.&4) +
  95.                           RSTDSP(&5) DFRWRT(&6)  PUBAUT(&7) +
  96.                           TEXT(&8)') FMT((*CHAR 10) (*CHAR 10) (*CHAR +
  97.                           10) (*CHAR 10) (*CHAR 4) (*CHAR 4) (*CHAR +
  98.                           7) (*CHAR 50)) /* Create CRTDSPF command */
  99.  
  100.              ADDMSGD    MSGID(PGM0007) MSGF(CRCMSGF.&MSGLIB) +
  101.                           MSG('CRTLF FILE(&1.&2) SRCFILE(&3.&4) +
  102.                           PUBAUT(&5) TEXT(&6)') FMT((*CHAR 10) (*CHAR +
  103.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*CHAR +
  104.                           50)) /* Create CRTLF command */
  105.  
  106.              ADDMSGD    MSGID(PGM0008) MSGF(CRCMSGF.&MSGLIB) +
  107.                           MSG('CRTMXDF FILE(&1.&2) SRCFILE(&3.&4) +
  108.                           PUBAUT(&5) TEXT(&6)') FMT((*CHAR 10) (*CHAR +
  109.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*CHAR +
  110.                           50)) /* Create CRTMXDF command */
  111.  
  112.              ADDMSGD    MSGID(PGM0009) MSGF(CRCMSGF.&MSGLIB) +
  113.                           MSG('CRTPF FILE(&1.&2) SRCFILE(&3.&4) +
  114.                           SIZE(&5 &6 &7) PUBAUT(&8) TEXT(&9)') +
  115.                           FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
  116.                           10) (*CHAR 8) (*CHAR 5) (*CHAR 6) (*CHAR 7) +
  117.                           (*CHAR 50)) /* Create CRTPF command */
  118.  
  119.              ADDMSGD    MSGID(PGM0010) MSGF(CRCMSGF.&MSGLIB) +
  120.                           MSG('CRTPRTF FILE(&1.&2) SRCFILE(&3.&4) +
  121.                           MAXRCDS(&5) SCHEDULE(&6) PUBAUT(&7) +
  122.                           TEXT(&8)') FMT((*CHAR 10) (*CHAR 10) (*CHAR +
  123.                           10) (*CHAR 10) (*CHAR 6) (*CHAR 8) (*CHAR +
  124.                           7) (*CHAR 50)) /* Create CRTPRTF command */
  125.  
  126.              ADDMSGD    MSGID(PGM0011) MSGF(CRCMSGF.&MSGLIB) +
  127.                           MSG('CRTRPTPGM PGM(&1.&2) SRCFILE(&3.&4) +
  128.                           USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
  129.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
  130.                           6) (*CHAR 7) (*CHAR 50)) /* Create +
  131.                           CRTRPTPGM command */
  132.  
  133.              ADDMSGD    MSGID(PGM0012) MSGF(CRCMSGF.&MSGLIB) +
  134.                           MSG('CRTRPGPGM PGM(&1.&2) SRCFILE(&3.&4) +
  135.                           GENOPT(&5) USRPRF(&6) PUBAUT(&7) TEXT(&8)') +
  136.                           FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
  137.                           10) (*CHAR 64) (*CHAR 6) (*CHAR 7) (*CHAR +
  138.                           50)) /* Create CRTRPGPGM command */
  139.  
  140.              ADDMSGD    MSGID(PGM0013) MSGF(CRCMSGF.&MSGLIB) +
  141.                           MSG('CRTCBLPGM PGM(&1.&2) SRCFILE(&3.&4) +
  142.                           USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
  143.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
  144.                           6) (*CHAR 7) (*CHAR 50)) /* Create +
  145.                           CRTCBLPGM command */
  146.  
  147.              ADDMSGD    MSGID(PGM0014) MSGF(CRCMSGF.&MSGLIB) +
  148.                           MSG('CRTPLIPGM PGM(&1.&2) SRCFILE(&3.&4) +
  149.                           USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
  150.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
  151.                           6) (*CHAR 7) (*CHAR 50)) /* Create +
  152.                           CRTPL1PGM command */
  153.  
  154.              ADDMSGD    MSGID(PGM0015) MSGF(CRCMSGF.&MSGLIB) +
  155.                           MSG('CRTASMPGM PGM(&1.&2) SRCFILE(&3.&4) +
  156.                           USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
  157.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
  158.                           6) (*CHAR 7) (*CHAR 50)) /* Create +
  159.                           CRTASMPGM command */
  160.  
  161.              ADDMSGD    MSGID(PGM0016) MSGF(CRCMSGF.&MSGLIB) +
  162.                           MSG('CRTBASPGM PGM(&1.&2) SRCFILE(&3.&4) +
  163.                           USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
  164.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
  165.                           6) (*CHAR 7) (*CHAR 50)) /* Create +
  166.                           CRTBASPGM command */
  167.  
  168.              ADDMSGD    MSGID(PGM0017) MSGF(CRCMSGF.&MSGLIB) +
  169.                           MSG('CRTBSCF FILE(&1.&2) SRCFILE(&3.&4) +
  170.                           PUBAUT(&5) TEXT(&6)') FMT((*CHAR 10) (*CHAR +
  171.                           10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*CHAR +
  172.                           50)) /* Create CRTBSCF command */
  173.  
  174.              ADDMSGD    MSGID(PGM1500) MSGF(CRCMSGF.&MSGLIB) +
  175.                           MSG('Creating PGMMENU defaults data area +
  176.                           for user &1.&2') SECLVL('The user profile +
  177.                           &1 was specified for the display menu +
  178.                           defaults command.  The user currently does +
  179.                           not have a defaults data area associated +
  180.                           with his user profile.  The defaults data +
  181.                           area name &1.&2 is being created.') +
  182.                           FMT((*CHAR 10) (*CHAR 10)) LOG(*YES)
  183.  
  184.              ADDMSGD    MSGID(PGM2011) MSGF(CRCMSGF.&MSGLIB) +
  185.                           MSG('CPYSRCF FROMFILE(&2.&3) TOFILE(&4) +
  186.                           FROMMBR(&1)') FMT((*CHAR 10) (*CHAR 10) +
  187.                           (*CHAR 10) (*CHAR 21)) +
  188.                           /* Copy source file member */
  189.  
  190.  CRTOBJ:     /*         Create DSPMNUDFT/PGMMENU related objects. */
  191.  
  192.  /* Files */
  193.  CRC1239F:   CRTPF      FILE(CRC1239.&OBJLIB) +
  194.                           SRCFILE(QDDSSRC.&SRCLIB) SIZE(1 0 0)
  195.  
  196.  CRC1235F:   CRTDSPF    FILE(CRC1235.&OBJLIB) +
  197.                           SRCFILE(QDDSSRC.&SRCLIB) RSTDSP(*YES)
  198.  
  199.  CRC1230F:   CRTDSPF    FILE(CRC1230.&OBJLIB) +
  200.                           SRCFILE(QDDSSRC.&SRCLIB) RSTDSP(*YES) +
  201.                           DFRWRT(*NO)
  202.  
  203.  /* Data Areas */
  204.  PGMMENUDA:  CRTDTAARA  DTAARA(PGMMENU.QGPL) TYPE(*CHAR) LEN(2000) +
  205.                           PUBAUT(*NORMAL) TEXT('CL-Programmer Menu: +
  206.                           system-wide defaults data area')
  207.  
  208.   /*  Programs */
  209.  CRC1235P:   CRTRPGPGM  PGM(CRC1235.&OBJLIB) SRCFILE(QRPGSRC.&SRCLIB) +
  210.                           GENOPT(*OPTIMIZE)
  211.  
  212.  CRC1234:    CRTCLPGM   PGM(CRC1234.&OBJLIB) SRCFILE(QCLSRC.&SRCLIB) +
  213.                           LOG(*NO) ALWRTVSRC(*NO)
  214.  
  215.  CRC1233P:   CRTRPGPGM  PGM(CRC1233.&OBJLIB) SRCFILE(QRPGSRC.&SRCLIB) +
  216.                           GENOPT(*OPTIMIZE)
  217.  
  218.  CRC1230P:   CRTCLPGM   PGM(CRC1230.&OBJLIB) SRCFILE(QCLSRC.&SRCLIB) +
  219.                           LOG(*NO) ALWRTVSRC(*NO) PUBAUT(*NONE) +
  220.  
  221.  PGMMNUDFT:  CRTCMD     CMD(PGMMNUDFT.&OBJLIB) PGM(CRC1234.&OBJLIB) +
  222.                           SRCFILE(QCMDSRC.&SRCLIB) ALLOW(*INTERACT +
  223.                           *EXEC)
  224.  
  225.              CRTCMD     CMD(PGMMENU.&OBJLIB) PGM(CRC1230.&OBJLIB) +
  226.                           SRCFILE(QCMDSRC.&SRCLIB) ALLOW(*INTERACT +
  227.                           *EXEC) MAXPOS(6) PUBAUT(*NONE)
  228.  
  229.              CHGPGM     PGM(CRC1230.&OBJLIB) OPTIMIZE(*YES)
  230.  
  231.              /*          Grant same authority as QPGMMENU.QSYS */
  232.              GRTOBJAUT  OBJ(CRC1230.&OBJLIB) OBJTYPE(*PGM) +
  233.                           REFOBJ(QPGMMENU.QSYS)
  234.  
  235.              /*          Grant same authority as QPGMMENU.QSYS */
  236.              GRTOBJAUT  OBJ(PGMMENU.&OBJLIB) OBJTYPE(*CMD) +
  237.                           REFOBJ(QPGMMENU.QSYS) REFOBJTYPE(*PGM)
  238.  
  239.  /* Change owner */
  240.              IF         (&OBJOWN *NE *CURRENT) DO
  241.  
  242.          /*  Files  */
  243.              CHGOBJOWN  OBJ(CRC1230.&OBJLIB) OBJTYPE(*FILE) +
  244.                           NEWOWN(&OBJOWN)
  245.  
  246.              CHGOBJOWN  OBJ(CRC1235.&OBJLIB) OBJTYPE(*FILE) +
  247.                           NEWOWN(&OBJOWN)
  248.  
  249.              CHGOBJOWN  OBJ(CRC1239.&OBJLIB) OBJTYPE(*FILE) +
  250.                           NEWOWN(&OBJOWN)
  251.  
  252.              CHGOBJOWN  OBJ(CRCMSGF.&OBJLIB) OBJTYPE(*MSGF) +
  253.                           NEWOWN(&OBJOWN)
  254.  
  255.          /*  Commands  */
  256.              CHGOBJOWN  OBJ(PGMMENU.&OBJLIB) OBJTYPE(*CMD) +
  257.                           NEWOWN(&OBJOWN)
  258.  
  259.              CHGOBJOWN  OBJ(PGMMNUDFT.&OBJLIB) OBJTYPE(*CMD) +
  260.                           NEWOWN(&OBJOWN)
  261.  
  262.          /*  Programs  */
  263.              CHGOBJOWN  OBJ(CRC1230.&OBJLIB) OBJTYPE(*PGM) +
  264.                           NEWOWN(&OBJOWN)
  265.  
  266.              CHGOBJOWN  OBJ(CRC1233.&OBJLIB) OBJTYPE(*PGM)  +
  267.                           NEWOWN(&OBJOWN)
  268.  
  269.              CHGOBJOWN  OBJ(CRC1234.&OBJLIB) OBJTYPE(*PGM)  +
  270.                           NEWOWN(&OBJOWN)
  271.  
  272.              CHGOBJOWN  OBJ(CRC1235.&OBJLIB) OBJTYPE(*PGM)  +
  273.                           NEWOWN(&OBJOWN)
  274.  
  275.              CHGOBJOWN  OBJ(PGMMENU.QGPL)  OBJTYPE(*DTAARA)  +
  276.                           NEWOWN(&OBJOWN)
  277.  
  278.              ENDDO
  279.  
  280.  RSTLIBL:    /*         Restore current job's library list. */
  281.  
  282.              CHGVAR     VAR(&CMD) VALUE('RPLLIBL LIBL(' *CAT &LIBL +
  283.                           *BCAT ')')
  284.              CALL       PGM(QCAEXEC) PARM(&CMD 512)
  285.  
  286.  RCVMSG:     /*         Receive and forward program messages. */
  287.              RCVMSG     RMV(*YES) MSGDTA(&MSGDTA) MSGID(&MSGID)
  288.              IF         (&MSGID *EQ ' ')  RETURN
  289.              IF         (%SST(&MSGID 1 2) *EQ 'CP'  +
  290.                      *OR %SST(&MSGID 1 3) *EQ 'MCH')  DO
  291.              IF         (&MSGDTA *EQ ' ') SNDPGMMSG  MSGID(&MSGID) +
  292.                           MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  293.              ELSE       SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) +
  294.                           MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  295.              CHGVAR     VAR(&CNT) VALUE(&CNT + 1)
  296.              ENDDO
  297.              IF         (&CNT *LT 10) GOTO RCVMSG
  298.  
  299.  
  300.